home *** CD-ROM | disk | FTP | other *** search
/ DP Tool Club 19 / CD_ASCQ_19_010295.iso / dos / prg / pas / swag / win_os2.swg / 0006_Window Fonts.pas < prev    next >
Pascal/Delphi Source File  |  1993-08-27  |  2KB  |  83 lines
  1. {
  2. MICHAEL A VINCZE
  3.  
  4. Below is an example I whipped up that shows how to vary the font in an edit control.
  5. The method can be extended to other controls as well.  Two methods are presented:
  6. using a stock object to get a fixed font, and using a created font.
  7.  
  8. I have not figured out how to get the colors to change though.
  9. }
  10.  
  11. program Font_Ctl;
  12.  
  13. uses
  14.   Win31, WinTypes, WinProcs,
  15.   Objects, OWindows, ODialogs;
  16.  
  17. const
  18.   ApplicationName : PChar = 'Font_Ctl';
  19.  
  20.   id_Edit1 = 201;
  21.   id_Edit2 = 202;
  22.   id_Edit3 = 203;
  23.  
  24. type
  25.   TFont_CtlApplication = object (TApplication)
  26.     procedure InitMainWindow; virtual;
  27.   end;
  28.  
  29.   PFont_CtlWindow = ^TFont_CtlWindow;
  30.   TFont_CtlWindow = object (TWindow)
  31.     EditBox : PEdit;
  32.     VarFont : HFont;
  33.     FixFont : THandle;
  34.  
  35.     constructor Init(AParent : PWindowsObject; ATitle : PChar);
  36.     procedure   SetupWindow; virtual;
  37.     destructor  Done; virtual;
  38.   end;
  39.  
  40. procedure TFont_CtlApplication.InitMainWindow;
  41. begin
  42.   MainWindow := New(PFont_CtlWindow, Init(nil, ApplicationName));
  43. end;
  44.  
  45. constructor TFont_CtlWindow.Init(AParent : PWindowsObject; ATitle : PChar);
  46. begin
  47.   inherited Init(AParent, ATitle);
  48.     EditBox := New(PEdit, Init (@Self, id_Edit1, 'EditBox 1 (normal)',
  49.                 10, 10, 500, 30, $FF, False));
  50.     EditBox := New(PEdit, Init (@Self, id_Edit2, 'EditBox 2 (fixed font)',
  51.                 10, 50, 500, 30, $FF, False));
  52.     EditBox := New(PEdit, Init (@Self, id_Edit3, 'EditBox 3 (variable font)',
  53.                 10, 90, 500, 30, $FF, False));
  54.     FixFont := GetStockObject (System_Fixed_Font);
  55.  
  56.     VarFont := CreateFont(20, 20, 0, 0, fw_DontCare, 0, 0, 0,
  57.                           Default_CharSet, Out_Default_Precis,
  58.                           Clip_Default_Precis, Default_Quality,
  59.                           Variable_Pitch or ff_DontCare, nil);
  60. end;
  61.  
  62. destructor TFont_CtlWindow.Done;
  63. begin
  64.   inherited Done;
  65.   DeleteObject(VarFont);
  66. end;
  67.  
  68. procedure TFont_CtlWindow.SetupWindow;
  69. begin
  70.   inherited SetupWindow;
  71.   SendMessage(GetDlgItem (HWindow, id_Edit2), wm_SetFont, FixFont, 1);
  72.   SendMessage(GetDlgItem (HWindow, id_Edit3), wm_SetFont, VarFont, 1);
  73. end;
  74.  
  75. var
  76.   Application : TFont_CtlApplication;
  77.  
  78. begin
  79.   Application.Init (ApplicationName);
  80.   Application.Run;
  81.   Application.Done;
  82. end.
  83.